home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 376-400 / disk_386 / xlispstat / src2.lzh / XLisp-Stat / utilities2.c < prev    next >
C/C++ Source or Header  |  1990-10-02  |  4KB  |  169 lines
  1. /* utilities2 - basic utility functions                                */
  2. /* XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney                  */
  3. /* Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz    */
  4. /* You may give out copies of this software; for conditions see the    */
  5. /* file COPYING included with this distribution.                       */
  6.  
  7. #include <string.h>
  8. #include "xlisp.h"
  9. #include "osdef.h"
  10. #ifdef ANSI
  11. #include "xlproto.h"
  12. #include "xlsproto.h"
  13. #include "osproto.h"
  14. #else
  15. #include "xlfun.h"
  16. #include "xlsfun.h"
  17. #include "osfun.h"
  18. #endif ANSI
  19. #include "xlvar.h"
  20.  
  21. /**************************************************************************/
  22. /**                                                                      **/
  23. /**                          Utility Functions                           **/
  24. /**                                                                      **/
  25. /**************************************************************************/
  26.  
  27. LVAL integer_list_2(a, b)
  28.     int a, b;
  29. {
  30.   LVAL list, temp;
  31.   
  32.   xlstkcheck(2);
  33.   xlsave(temp);
  34.   xlsave(list);
  35.   temp = cvfixnum((FIXTYPE) b); list = consa(temp);
  36.   temp = cvfixnum((FIXTYPE) a); list = cons(temp, list);
  37.   xlpopn(2);
  38.   return(list);
  39. }
  40.  
  41. LVAL integer_list_3(a, b, c)
  42.     int a, b, c;
  43. {
  44.   LVAL list, temp;
  45.   
  46.   xlstkcheck(2);
  47.   xlsave(temp);
  48.   xlsave(list);
  49.   temp = cvfixnum((FIXTYPE) c); list = consa(temp);
  50.   temp = cvfixnum((FIXTYPE) b); list = cons(temp, list);
  51.   temp = cvfixnum((FIXTYPE) a); list = cons(temp, list);
  52.   xlpopn(2);
  53.   return(list);
  54. }
  55.  
  56. LVAL integer_list_4(a, b, c, d)
  57.     int a, b, c, d;
  58. {
  59.   LVAL list, temp;
  60.   
  61.   xlstkcheck(2);
  62.   xlsave(temp);
  63.   xlsave(list);
  64.   temp = cvfixnum((FIXTYPE) d); list = consa(temp);
  65.   temp = cvfixnum((FIXTYPE) c); list = cons(temp, list);
  66.   temp = cvfixnum((FIXTYPE) b); list = cons(temp, list);
  67.   temp = cvfixnum((FIXTYPE) a); list = cons(temp, list);
  68.   xlpopn(2);
  69.   return(list);
  70. }
  71.  
  72. LVAL send_message(object, msg)
  73.      LVAL object, msg;
  74. {
  75.   LVAL argv[2];
  76.   
  77.   argv[0] = object;
  78.   argv[1] = msg;
  79.   return(xscallsubrvec(xmsend, 2, argv));
  80. }
  81.  
  82. LVAL send_message1(object, msg, a)
  83.     LVAL object, msg;
  84.     int a;
  85. {
  86.   LVAL La, result, argv[3];
  87.   
  88.   xlsave(La);
  89.   La = cvfixnum((FIXTYPE) a);
  90.   argv[0] = object;
  91.   argv[1] = msg;
  92.   argv[2] = La;
  93.   result = xscallsubrvec(xmsend, 3, argv);
  94.   xlpop();
  95.   return(result);
  96. }
  97.  
  98. LVAL send_message_1L(object, symbol, value)
  99.      LVAL object, symbol, value;
  100. {
  101.   LVAL argv[3];
  102.   
  103.   argv[0] = object;
  104.   argv[1] = symbol;
  105.   argv[2] = value;
  106.   return(xscallsubrvec(xmsend, 3, argv));
  107. }
  108.  
  109. LVAL apply_send(object, symbol, args)
  110.      LVAL object, symbol, args;
  111. {
  112.   LVAL result;
  113.  
  114.   xlprot1(args);
  115.   args = cons(symbol, args);
  116.   args = cons(object, args);
  117.   result = xsapplysubr(xmsend, args);
  118.   xlpop();
  119.   return(result);
  120. }
  121.  
  122. LVAL double_list_2(a, b)
  123.     double a, b;
  124. {
  125.   LVAL list, temp;
  126.   
  127.   xlstkcheck(2);
  128.   xlsave(temp);
  129.   xlsave(list);
  130.   temp = cvflonum((FLOTYPE) b); list = consa(temp);
  131.   temp = cvflonum((FLOTYPE) a); list = cons(temp, list);
  132.   xlpopn(2);
  133.   return(list);
  134. }
  135.  
  136. /* make a LISP string from a C string */
  137. LVAL make_string(s)
  138.     char *s;
  139. {
  140.   LVAL result = newstring(strlen(s) + 1);
  141.   strcpy(getstring(result), s);
  142.   return(result);
  143. }
  144.  
  145. LVAL xsnumtostring()
  146. {
  147.   LVAL x;
  148.   
  149.   x = xlgetarg();
  150.   xllastarg();
  151.   
  152.   if (fixp(x)) sprintf(buf, "%ld", (long) getfixnum(x));
  153.   else if (floatp(x)) sprintf(buf, "%g", (double) getflonum(x));
  154.   else xlerror("not a number", x);
  155.   
  156.   return(make_string(buf));
  157. }
  158.  
  159. LVAL xssysbeep()
  160. {
  161.   int count = 10;
  162.   if (moreargs()) count = getfixnum(xlgafixnum());
  163.   xllastarg();
  164.   
  165.   SysBeep(count);
  166.   return(NIL);
  167. }
  168.  
  169.